;;; Code from https://okmij.org/ftp/Scheme/macros.html#ck-macros.

;;; Some comments added by me <zelphirkaltstahl@posteo.de>.
;;; Some renaming for readability by me <zelphirkaltstahl@posteo.de>.
;;; Some formatting by me <zelphirkaltstahl@posteo.de>.

;; TODO: Explain this thing :D
(define-syntax ck
  (syntax-rules (quote)
    ;; This is a base case, which unquotes quoted
    ;; expressions, so that they are evaluated at runtime,
    ;; instead of remaining quoted.
    [(ck () 'v) v]                      ; yield the value on empty stack

    [(ck (((op ...) ea ...) . s) 'v)    ; re-focus on the other argument, ea
     (ck s "arg" (op ... 'v) ea ...)]

    [(ck s "arg" (op va ...))           ; all arguments are evaluated,
     (op s va ...)]                    ; do the redex

    [(ck s "arg" (op ...) 'v ea1 ...)   ; optimization when the first ea
     (ck s "arg" (op ... 'v) ea1 ...)] ; was already a value

    [(ck s "arg" (op ...) ea ea1 ...)   ; focus on ea, to evaluate it
     (ck (((op ...) ea1 ...) . s) ea)]

    [(ck s (op ea ...))                 ; Focus: handle an application;
     (ck s "arg" (op) ea ...)]         ; check if args are values
    ))


(define-syntax c-cons
  (syntax-rules (quote)
    ;; As mentioned in the explanation on
    ;; https://okmij.org/ftp/Scheme/macros.html#ck-macros:
    ;; All things except the stack are quoted. c-cons
    ;; expects 2 values, head and tail.

    ;; In contrast to the normal pattern matching in macros,
    ;; the parts of a pattern need to be quoted. This is
    ;; probably due to CK macros building yet another layer
    ;; on top of normal macros, managing things in a stack
    ;; and having to avoid things getting evaluated (or
    ;; expanded in case of other, possibly non-CK macros)
    ;; too early.

    ;; For example, macro expansion would evaluate a lambda
    ;; too early, if it appeared without being quoted.

    ;; This however, does not stop us from using pattern
    ;; matching on those quoted values! We can still write
    ;; something like the following:

    ;; (c-mymacro stack '(bla blub) 'other)

    ;; And then use the parts in the resulting expression as
    ;; we want, but again quote the resulting expression.
    [(c-cons stack 'head 'tail)
     ;; Build up a pair. Always pass the stack along to the
     ;; CK macro.
     (ck stack '(head . tail))]))


(define-syntax c-append
  ;; Note, that quote is specified as a literal.
  (syntax-rules (quote)
    ;; As one would expect, appending some "anything" to the
    ;; empty list, will result in "anything".
    [(c-append stack '() 'l2)
     (ck stack 'l2)]

    ;; Pattern match on the first argument, destructuring it
    ;; into a head and a tail. As mentioned, this is still
    ;; possible, we only have to quote the thing.
    [(c-append stack '(head . tail) 'l2)
     (ck
      ;; Remember to always pass the stack along.
      stack
      ;; Reduce the problem size, by taking the head and
      ;; recursively calling/expanding c-append for the tail
      ;; and the second list.
      (c-cons 'head
              ;; Recursively expand the macro.
              (c-append 'tail 'l2)))]))


;; Except for the additional quoting, this feels like
;; writing normal procedures! Great!

;; To quote things, we need to simply wrap with another
;; quote. This makes sense, because in the base case of the
;; CK-macro 1 quote wrapping is removed:

;; [(ck () 'v) v]

;; (see above).
(define-syntax c-quote
  (syntax-rules (quote)
    [(c-quote s 'x)
     (ck s ''x)]))


;; Try append for a simple list of numbers:
(ck ()
    (c-quote
     (c-append '(1 2 3)
               '(4 5))))


;; Try append for something involving a lambda expression,
;; which would not work with normal syntax-rules macros,
;; because lambda itself is a macro and would get expanded
;; too early, before its arguments:
(ck ()
    (c-append '()
              ;; an immediately applied lambda, but quoted,
              ;; which avoids too early expansion!
              '((lambda (a) (list a 4 5)) 3.5)))
